SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00005 1 08-24-9413:54ALL JOSE CAMPIONE Faster READLN SWAG9408 AKR+ 20 F╔ {π I have been exploring a faster way to read lines from textπ files. This one seems to be 30% faster than readln even withπ a full settextbuffer of $FFFF. However, it only works forπ files smaller than 64K ($FFF1) and all lines, including theπ last one, must end in the CR/LF word (readln recognizes theπ EOF (01Ah) char also as an end of line). Please repost anyπ improvements. }ππ program readtext;ππ Uses CRT;ππ const π maxsize = $FFF0;π π typeπ barr = array[0..maxsize] of byte;π ptrbarr = ^barr;ππ varπ f : file;π s : string;π p : longint;π fsiz : longint;π fbuf : ptrbarr;π π function pos13(pnt:pointer): word; assembler;π asmπ les di,[pnt] {load pointer in es:di}π mov cx,$00FF {load maximum size to scan in cx}π mov bx,cx {save maximum size to scan in bx}π mov al,$0D {load in al byte to match = 0Dh}π cld {increment di}π repne scasb {search loop}π je @found {jump if found}π mov ax,0 {if not found report result = 0}π jmp @fin {goto end}π @found: {if found...}π sub bx,cx {get position matched}π mov ax,bx {report result = position matched}π @fin:π end;π π procedure readx(fbuf:ptrbarr;var s:string;var p:longint);π varπ q : word;π b : ptrbarr;π beginπ b:= addr(fbuf^[p]); {point to first byte in remaining block}π q:= pos13(b); {get position of first $0D occurence}π move(b^,s[1],pred(q)); {transfer preceeding bytes to string}π s[0]:= char(pred(q)); {assign size byte to Pascal string}π inc(p,succ(q)); {adjust pointer skipping 1 byte ($0A)}π end;ππ beginπ ClrScr;π if paramcount = 0 thenπ BEGINπ writeLn( 'Enter FILENAME on commandline');π halt;π END;π assign(f,paramstr(1));π reset(f,1);π fsiz:= filesize(f);π if fsiz > maxsize then halt;π getmem(fbuf,fsiz);π blockread(f,fbuf^,fsiz);π close(f);π p := 0; {initialize pointer to position in fbuf^}π while p < fsiz do beginπ readx(fbuf,s,p);π writeln(s);π end;π dispose(fbuf);π end.ππ 2 08-24-9417:50ALL WIM VAN DER VEGT Text File Objects SWAG9408 Bjúm 57 F╔ {πHere's a piece of code I wrote last year which does what wasn'tπuploaded. It allows text files converted to obj format to be linked inπand being accessed as 'normal' turbo pascal text files. The 'object'πtext files support reset, read, readln eof, eoln and close fileπcommands.ππWhat you need to write in your program is a obj_find function whichπtranslates filenames into pointers or returns NIL to indicate anπexternal file. Use Assign_text procedure instead. A sample of how toπuse it is supplied in the second program/unit. Only the two linked inπfiles will be fetched from memory, any other name supplied will beπfetched from disk as usual.ππThe first unit can be the same for all projects, the second one isπproject depended, because one will be using different files.ππQuestion about this, ask them!ππ}π{---------------------------------------------------------}π{ Project : Object linked textfiles }π{ By : Ir.G.W. van der Vegt }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 930914.2200 Creatie. }π{ 930915.2200 Support for Settextbuffer. Bufptr used }π{ again for addressing & pointer advancing }π{ adjusted. }π{---------------------------------------------------------}π{ Usage : Convert textfile to obj with turbo's BINOBJ }π{ Add them to a unit as show in this sample }π{ Create a custom filename to func address }π{ converter as show in My_getp. This function }π{ should return NIL if the requested file isn't }π{ linked in. Use Obj_assign to get assign the }π{ filevar. Reset, Read, Readln & Close are }π{ allowed. If a file isn't found it's searched on}π{ disk. Pathnames are stripped when searching for}π{ linked-in files. }π{---------------------------------------------------------}ππUnit Obj_01;ππINTERFACEππTypeπ Obj_find = Function(fn : String) : Pointer;ππVarπ Obj_getp : Obj_find;ππProcedure Obj_Assign(VAR tpl : Text;fn : String;decoder : Obj_find);ππIMPLEMENTATIONππUsesπ Dos;ππ{---------------------------------------------------------}π{----To simplyfy addressing inside the buffer, the segment}π{ of the pointer to the text in memmory is incremented }π{ instead of using the old Longint typecast trick }π{---------------------------------------------------------}ππConstπ para = 16;ππTypeπ obj_user = Recordπ base,π curr : Pointer;π dummy : ARRAY[1..8] OF Byte;π End;ππ{---------------------------------------------------------}π{----Ignore handler }π{---------------------------------------------------------}π{$F+}πFunction Obj_ignore(VAR f : textrec) : Integer;ππBeginπ Obj_ignore:=0;πEnd; {of Obj_ignore}π{$F-}ππ{---------------------------------------------------------}π{----Inoutfunc handler }π{---------------------------------------------------------}π{$F+}πFUNCTION Obj_input(VAR f : textrec) : INTEGER;ππVARπ p : Pointer;ππBEGINπ WITH Textrec(f) DOπ BEGINπ {----Advance Pointer obj_size paragraphs}π p:=Ptr(Seg(obj_user(userdata).curr^)+(bufsize DIV para),π Ofs(obj_user(userdata).curr^));π obj_user(userdata).curr:=p;π Move(obj_user(userdata).curr^,bufptr^,(bufsize DIV para)*para);π bufpos :=0;π bufend :=(bufsize DIV para)*para;π END;π obj_input:=0;πEND; {of obj_input}π{$F-}π{---------------------------------------------------------}π{----Open func handler }π{---------------------------------------------------------}π{$F+}πFUNCTION obj_open(VAR f : textrec) : INTEGER;ππBEGINπ WITH Textrec(f) DOπ BEGINπ obj_user(userdata).curr:=obj_user(userdata).base;π Move(obj_user(userdata).base^,bufptr^,(bufsize DIV para)*para);π bufpos :=0;π bufend :=(bufsize DIV para)*para;π END;π obj_open:=0;πEND; {of obj_open}π{$F-}π{---------------------------------------------------------}π{----Assign a link-in file or disk file }π{---------------------------------------------------------}ππProcedure Obj_Assign(VAR tpl : Text;fn : String;decoder : Obj_find);ππVARπ tplp : POINTER;π i : Byte;ππBEGINππ If (Addr(decoder)=NIL)π THEN tplp:=NILπ ELSE tplp:=Decoder(fn);ππ IF (tplp<>NIL)π THENπ WITH Textrec(tpl) DOπ BEGINπ handle :=$ffff;π mode :=fmclosed; {fminput}π bufsize :=SIZEOF(textbuf);π bufpos :=0;π bufptr :=@buffer;ππ obj_user(userdata).base:=tplp;π obj_user(userdata).curr:=tplp;ππ openfunc :=@obj_open;π inoutfunc:=@obj_input;π flushfunc:=@obj_ignore;π closefunc:=@obj_ignore;ππ i:=0;π While (i<Length(fn)) AND (i<Sizeof(name)) DOπ Beginπ name[i]:=Upcase(fn[i+1]);π Inc(i);π End;π name[i] :=#00;π ENDπ ELSE Assign(tpl,Fexpand(fn));πEND; {of obj_open}ππEND.πππ---------------<source part II, to link in your text files.ππ{---------------------------------------------------------}π{ Project : Object linked textfiles }π{ Unit : Sample program }π{ By : Ir.G.W. van der Vegt }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 930914.2200 Creatie. }π{---------------------------------------------------------}ππUnit Objtext;ππInterfaceππProcedure Assign_text(VAR tpl : Text;fn : String);ππImplementationππ{---------------------------------------------------------}ππUsesπ Dos,π Obj_01;ππ{---------------------------------------------------------}π{----SAMPLE Get_obj Function}π{$L SAMPLE_d.obj}π{$L SAMPLE_m.obj}ππ{---------------------------------------------------------}ππFUNCTION SAMPLE_D : Byte ; External;πFUNCTION SAMPLE_M : Byte ; External;ππ{---------------------------------------------------------}π{$F+}πFUNCTION My_getp(fn : String) : Pointer;ππVARπ name : String[12];π d : dirstr;π n : namestr;π e : extstr;ππBeginπ Fsplit(Fexpand(fn),d,n,e);ππ My_getp:=NIL;ππ name:=Strip(Upcasestr(n+e),true,true);ππ {12345678.123}π IF name= 'SAMPLE.D' THEN My_getp:= @Sample_d;π IF name= 'SAMPLE.M' THEN My_getp:= @Sample_m;πEnd; {of My_getp}ππ{---------------------------------------------------------}ππProcedure Assign_text(VAR tpl : Text;fn : String);ππBeginπ Obj_assign(tpl,fn,Obj_find(Assign_decoder));πEnd;ππ{---------------------------------------------------------}πππ{---------------------------------------------------------}ππBeginπ Assign_decoder:=@My_getp;πEnd.π 3 08-24-9417:54ALL NORBERT IGL Good file Viewer SWAG9408 F aσ 26 F╔ {π IP> Does anyone have a source to a viewer out there? Im lookingπ IP> for one kinda like List.com or whatever.. where you can use yourπ IP> arrow keys to list the file.. Thanx alot!!!!!!!!!!!!!!!!!!!!π}ππ Program Viewer;π (*$M $800,0,$A0000 *)ππ Usesπ crt;ππ Type TextBlock = Array[1..16000] of ^String; { lines enough? 8-) }ππ Var VText : TextBlock;π Lines : integer;π Last : integer;ππ Procedure Init(N:string);π Var F: text;π S: String;π beginπ FillChar( VText, Sizeof(Vtext), 0 );π Lines := 0;π Assign( f, N );π(*$I-*)π Reset( f );π(*$I+*)π If IoResult <> 0 then exit;π While ( not EOF( F ) )π AND ( Maxavail > 80 ) do { assume a 80-Char-String }π beginπ Inc( Lines );π ReadLn( F, S );π If Length(S) > 80π Then S[0] := #80;π GetMem( Vtext[Lines], 1+Length(S) );π VText[Lines]^ := S;π end;π Last := Lines;π if not eof( F )π then Write(' Sorry, only ')π else Write(' All ');π Writeln( Lines,' Lines of ', N , ' read. ');π Close( F );π end;ππ Procedure Display(N:String);π Var ch : Char;π akt: integer;π Procedure Update;π Var y,i: integer;π beginπ if akt > ( Last - 22 )π then akt := last - 22;π if akt < 1π then akt := 1;π y := 2;π for i := akt to akt + 22 doπ beginπ gotoxy( 1, y );π ClrEol;π inc( y );π if i <= Last then write( VText[i]^ );π end;π TextAttr := $70; (* Black on Gray *)π Gotoxy(70,25);π if akt+23 > Lastπ then Write(akt,'..',Last)π else Write(akt,'..',akt+22);π ClrEolπ end;π beginπ TextAttr := $70; (* Black on Gray *)π ClrScr;π Gotoxy( 2, 1);π Write('The All Dancing and Singing Textfile Viewer');π Write(' Norbert Igl, 2:2453/50.3@Fido');π Gotoxy( 2,25);π while Pos('\',N) > 0 do delete(n,1,1);π for akt := 1 to length(N) do N[akt] := upcase(n[akt]);π Write('File: ',N,', ',Last,' Lines, ');π Write( MemAvail,' Bytes free.');π Gotoxy(63,25); Write('Lines: ');π akt := 1;π repeatπ TextAttr := $1F; { white on blue }π Update;π repeatπ ch := ReadKey;π if ch = #0 thenπ beginπ ch := readkey;π case ch ofπ 'H' : ch := #1; { up }π 'P' : ch := #2; { down }π 'Q' : ch := #3; { pg-up }π 'I' : ch := #4; { pg-down }π 'G' : ch := #5; { home }π 'O' : ch := #6; { end }π else ch := #0; { discard }π endπ endπ until Ch in [#27, #1..#6 ] ;π case Ch ofπ #1 : dec( akt );π #2 : inc( akt );π #3 : inc( akt, 22 );π #4 : dec( akt, 22 );π #5 : akt := 1;π #6 : akt := last-22;π end;π until ch=#27;π end;ππ procedure CleanUp;π Var I : Integer;π beginπ for I := last downto 1 doπ FreeMem( Vtext[i], 1+Length(VText[i]^) );π TextAttr := 7;π ClrScr;π end;ππ beginπ if Paramcount <> 1 thenπ beginπ writeln(' Usage : VIEWER [Drive:[\Path\]] FileName.Ext');π haltπ end;π Init(paramstr(1));π if Lines > 0 thenπ beginπ Display(paramstr(1));π CleanUpπ end;π end.π 4 08-25-9409:05ALL SCOTT F. EARNEST SConvert Upgrade SWAG9408 ÄSwé 87 F╔ {πFrom: "Scott F. Earnest" <tiobe+@CMU.EDU>ππAbout a month ago, I posted a program called "SmartConvert" which does auto-πmatic conversions between DOS and UNIX format text files.ππUnfortunately, there were a couple problems with the code I posted I wasn'tπaware of:ππ1.) While debugging, I accidentally removed the code which called theπ procedures to check that the files existed. Hopefully nobody'sπ gotten in trouble by overwriting files they didn't mean to. . . .π2.) S . . . L . . . O . . . W . . . ! I clocked a large file (~650K)π both ways, and got a time over 7 minutes. In this version, Iπ reassigned the text file buffers to 8K, and got much better times.ππI've also added an overwrite switch to ignore the output file.ππAnd could the kind soul(s) who donated the previous version to SWAG pleaseπmake sure this replaces the old version in the next upgrade? Thanks!ππ ■ Done! - Kerry ■π}πprogram SConvert;ππ{Smart-converts UN*X/DOS format filesππ Usage: sconvert infile [outfile] [/u | /d] [/o]ππ /u -- force output to UNIX (LF only)π /d -- force output to DOS (CR/LF)π /o -- Overwrite output file if it exists (for batch support)ππ -- or --ππ sconvert /? (-?, /h, -h, /H, and -H analogous)π for help messageππ This program is capabable of having its output piped, providedπ it is the first in the pipeline. Doesn't do well as an inter-π mediary pipe section.ππ Written by Scott F. Earnest, Aug 1993π Original version: 30 Aug 1993π Updated versions: 9 May 1994 (Added force flags.)π 9 Jun 1994 (Bug fix, added /o flag.)ππ This version uses 8K input/output buffers instead of the default 128-byteπ text buffers. The result is a performance of over 250% (only noticeableπ with large files). Untyped files turned out to be worthless here--theyπ performed worse than text files, believe it or not.ππ Unless I come up with a phenomenal improvement, this is the last versionπ I plan to post.π}ππuses Crt;ππconstπ CR = chr(13); {Carriage Return}π LF = chr(10); {Line Feed}ππtypeπ sys = (dos,unix,bad); {system identifier}π {Note to people who make upgrades--if youπ need the DOS unit, you'll have to modifyπ this variable so that "DOS" isn't a label.}π fbuf = array [0 .. 8191] of char;ππvarπ sysID : sys; {system identifier for case branch}π infile, outfile : string; {input/output files}π force : sys; {what mode to work in}π overwrite : boolean; {(don't) check if outfile exists}π ibuf, obuf : fbuf; {increase text buffers}ππfunction exist (filename : string) : boolean;ππ{Check if a file exists or notπ returns: true --> file existsπ false --> file non-existent}ππvarπ openfile : text;π errcode : integer;ππbeginπ {$I-} {Turn off error-checking}π assign (openfile, filename);π reset (openfile);π {$I+} {Turn it back on}π errcode := IOResult; {Get error code}π if errcode <> 0 then {There's an error if non-zero}π exist := false {So flag that it doesn't exist.}π elseπ beginπ close (openfile); {Otherwise, close file}π exist := true; {Flag that it does exist}π end;πend;ππfunction selectyn : boolean;ππ{Get a yes/no single-keypress responseπ returns: true --> yes response, y or Yπ false --> no response, n or N}ππvarπ getchar : char; {Need something to read into}ππbeginπ while KeyPressed do {Clean keyboard buffer}π getchar := ReadKey;π repeat {Get a key until it's a (Y)es or (N)o.}π getchar := ReadKey;π getchar := upcase (getchar);π until (getchar in ['Y', 'N']);π writeln (getchar); {Print the response}π case getchar of {Tell it what it should return}π 'Y' : selectyn := true;π 'N' : selectyn := false;π end;πend;ππprocedure help (badflag : boolean);ππ{brief message if command format was abused}ππbeginπ writeln ('SmartConvert, Written by Scott F. Earnest -- v1.4 -- 9 Jun 1994');π writeln;π if badflag thenπ beginπ writeln ('Invalid flag.');π writeln;π end;π writeln ('Usage');π writeln (' sconvert infile [outfile] [/d | /u] [/o]');π writeln;π writeln (' /d -- convert input to DOS format');π writeln (' /u -- convert input to UNIX format');π writeln (' /o -- unconditionally overwrite output');π writeln (' (for batch files or writing to devices)');π halt (1);πend;ππprocedure incheck (filename : string);ππ{Make sure source exists, if specified}ππbeginπ if not (exist (filename)) thenπ beginπ writeln ('Source file does not exist!');π halt (3);π end;πend;ππprocedure outcheck (filename : string);ππ{Make sure target does NOT exist, if specified, allow overwrite}ππvarπ select : boolean;ππbeginπ if exist (filename) and (filename <> '') thenπ beginπ write ('Target file exists! Overwrite? [y/n] ');π select := selectyn;π case select ofπ true : ;π false : halt (4);π end;π end;πend;ππfunction checktype (readfile : string) : sys;ππvarπ FileCheck : text;π checkvar : sys;π CROk, LFOk : boolean;π ReadBuf : char;ππbeginπ CROk := False;π LFOk := False; {Init flags.}π checkvar := bad; {Assume that type isn't known.}π assign (FileCheck, readfile);π reset (FileCheck);π while (not eof(FileCheck)) and (not CROk) and (not LFOk) doπ begin {Look for CR or LF}π read (FileCheck, ReadBuf);π if ReadBuf = CR then {CR found?}π beginπ CROk := True; {If yes, set the CR flag.}π Read (FileCheck, ReadBuf); {and get next char}π if ReadBuf = LF then {next one a LF?}π LFOk := True; {Flag it as found.}π if CROk and LFOk then {So is it CR/LF?}π beginπ checktype := dos; {If yes, specify DOS, and exit.}π close (FileCheck);π exit;π end;π end;π if ReadBuf = LF then {Found a LF?}π beginπ checktype := unix; {If yes, assume unix.}π close (FileCheck); {Close and exit.}π exit;π end;π end;π if checkvar = bad then {If there was a problem:}π beginπ writeln ('Ambiguous file type. Can''t determine type.');π close (FileCheck);π halt(2);π end;πend;ππprocedure dos2unix (infile, outfile : string);ππvarπ intext, outtext : text;π ReadBuf1, ReadBuf2 : char;ππbeginπ writeln ('Converting DOS -> UNIX. . . .');π assign (intext, infile);π settextbuf (intext, ibuf, sizeof(ibuf));π reset (intext);π assign (outtext, outfile);π settextbuf (outtext, obuf, sizeof(obuf));π rewrite (outtext);π while not eof(intext) doπ beginπ read (intext, ReadBuf1); {Get character}π if ReadBuf1 = CR then {If it's CR then. . . }π beginπ read (intext, ReadBuf2); {. . . get next . . .}π if ReadBuf2 = LF then {. . . and see if it's LF.}π write (outtext, LF) {If yes, just put LF into new file.}π elseπ write (outtext, ReadBuf1, ReadBuf2); {Not CR/LF, dump to file.}π endπ elseπ write (outtext, ReadBuf1); {Dump the character to file.}π end;π close (intext);π close (outtext);πend;ππprocedure unix2dos (infile, outfile : string);ππvarπ intext, outtext : text;π ReadBuf : char;ππbeginπ writeln ('Converting UNIX -> DOS. . . .');π assign (intext, infile);π settextbuf (intext, ibuf, sizeof(ibuf));π reset (intext);π assign (outtext, outfile);π settextbuf (outtext, obuf, sizeof(obuf));π rewrite (outtext);π while not eof(intext) doπ beginπ read (intext, ReadBuf); {Get a character.}π if ReadBuf = LF then {Is it LF?}π write (outtext, CR+LF) {If yes, put a CR/LF in its place.}π elseπ write (outtext, ReadBuf); {Otherwise, replace the character.}π end;π close (intext);π close (outtext);πend;ππprocedure getcommandline;ππ{get commandline info. . . .}ππvarπ pnum : byte; {paramater counter}π pstr : string[2]; {string snippet}π fname : string; {temporary string}ππbeginπ if (paramcount < 1) or (paramcount > 4) thenπ help (false); {too few, too many--show help}π infile := ''; {Init names.}π outfile := '';π force := bad;π for pnum := 1 to paramcount do {Do this in two passes.}π begin {#1.) Flags}π pstr := paramstr(pnum); {Get parameter.}π pstr[2] := upcase(pstr[2]);π if pstr[1] in ['-', '/'] then {Flag?}π case pstr[2] of π 'H', '?' : help (false); {Is help.}π 'D' : force := dos; {Is force DOS.}π 'U' : force := unix; {Is force UNIX.}π 'O' : overwrite := true; {is overwrite.}π elseπ help (true); {Bad switch.}π end;π end;π for pnum := 1 to paramcount do {#2.) Filenames}π begin π fname := paramstr(pnum); {Get parameter.}π if not (fname[1] in ['-', '/']) thenπ begin {If not flag then}π if infile = '' then {Get infile}π infile := fnameπ else if (infile <> '') and (outfile = '') thenπ outfile := fname {Get outfile}π elseπ help (false); {Oops, too many.}π end;π end;πend;ππbeginπ overwrite := false; {Initialize flag}π getcommandline; {Parse parameters}π sysID := checktype (infile); {Check the input file type}π incheck (infile); {verify that infile exists}π if not overwrite then {/o specified?}π outcheck (outfile); {verify that outfile doesn't exist}π if sysID = force then {If it's getting forced, then}π begin {compare types and skip if same.}π write ('Input file is already type ');π case sysID ofπ dos : write ('DOS');π unix : write ('UNIX');π end;π writeln (', skipped.');π halt(5);π end;π case sysID ofπ dos : dos2unix (infile, outfile); {DOS -> UNIX}π unix : unix2dos (infile, outfile); {UNIX -> DOS}π bad : begin {Not likely to happen but. . . .}π writeln ('Internal error! Check source code and recompile.');π halt (6);π end;π end;πend.π 5 08-25-9409:09ALL AFAD@ACAD2.ALASKA.EDU Speeding up text files SWAG9408 ZI~ë 15 F╔ {πThe most important thing when processing text files is to allocateπa large buffer for reading & writing the files. By default, TPπallocates 2k for reads & writes. Increasing this buffer to as littleπ(111 min left), (H)elp, More? as 10k significantly speeds up programs.πUsing larger text buffers is painless: you simply set a text buffer.πBefore closing the files, you really should do a flush() on any outputπtext file you're buffering.ππThe following code segment is what I use in my programs to establishπthe largest possible text buffer (64k-8, if memory available):πThe lines below create a maximum size file buffer for a text file fromπmemory available on the heap. Once the buffer has been created and assignedπto the file, i/o can proceed with normal READLN commands.πThe buffer is automatically created to the maximum possible size permittedπby TP (64k - 8 bytes), or the largest size permitted by available memory.ππ"Tbuffsize" can be any variable of type LongInt. It is only used duringπthe creation of the buffer and can be reused for any purpose.π}ππ{Declarations..}ππVarπ Target : Text; { Text file handle }π TBuff : Pointer; { Buffer }π TBuffsize : LongInt; { Size of buffer }ππ{Code}π tbuffsize:=Maxavail; {Find available memory block}π if tbuffsize > $fff0 {Limit to max. data object size}π then tbuffsize := $fff0;π getmem(tbuff,tbuffsize); {Grab memory, hook to pointer}π settextbuf(target,tbuff^,tbuffsize); {Attach new buffer to text file}π reset(target); {Open file with buffer}ππ{πWhen processing text on floppy disks, I find this frequently reduces theπprogram to executing only a single read - which speeds up execution byπa factor of 10.π}π
